home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #324 (1994-04)(Rhein-Sieg-Soft).zip / Franz PD Disk #324 (1994-04)(Rhein-Sieg-Soft).adf / VideoText3.5 / source / VTview.p < prev    next >
Text File  |  1994-04-01  |  15KB  |  491 lines
  1. PROGRAM VTview;
  2. FROM vt USES pagelist,decode;
  3. { Stellt roh abgespeicherte Videotextseiten auf einem eigenen Screen dar. }
  4. CONST version = '$VER: VTview 1.3';
  5.  
  6. { etwas Systemspezifisches: }
  7. {$opt q,s+,i+ - keine Laufzeitprüfungen außer Stack und Feldindizes }
  8. {$incl "exec.lib", "intuition.lib", "graphics.lib", "diskfont.lib" }
  9. {$incl "dos.lib", "workbench/startup.h", "icon.lib" }
  10.  
  11. VAR NeuerScreen: NewScreen; STATIC;
  12.     MyScreen: ^Screen;
  13.     NeuesWindow: NewWindow; STATIC;
  14.     MyWindow: ^Window;
  15.     Con: ptr;
  16.     sig: long;
  17.     titel: Str80; STATIC;
  18.     topazAttr,teleAttr: TextAttr; STATIC;
  19.     MyFont: ^TextFont;
  20.  
  21. { nun die anwendungsorientierten Variablen: }
  22.  
  23. VAR j, timing, countdown, anzseiten: integer;
  24.     auto, cycle, conceal: boolean;
  25.     taste,ch: Char;
  26.     s: Str80; STATIC;
  27.  
  28. { ###################################################################### }
  29. { --------------------- Allgemeine Hilfsroutinen ----------------------- }
  30. { ###################################################################### }
  31.  
  32. procedure cursoroff;
  33. begin
  34.   write(#155'0 p');  { Cursor unsichtbar }
  35. end;
  36.  
  37. procedure cursoron;
  38. begin
  39.   write(#155' p');  { Cursor wieder sichtbar }
  40. end;
  41.  
  42. function readkey: char;
  43. begin
  44.   readkey := ReadCon(Con);
  45. end;
  46.  
  47. function waitkey: char;
  48. var taste: char;
  49.     sig: long;
  50. begin
  51.   repeat
  52.     sig := wait(-1);
  53.     taste := ReadCon(Con);
  54.   until taste <> chr(0);
  55.   waitkey := taste;
  56. end;
  57.  
  58. procedure desaster(meldung: str80);
  59. { erzeugt einen Alert }
  60. var egal: boolean;
  61.     buf: string;
  62.     xpos: integer;
  63. begin
  64.   xpos := 320 - 4*length(meldung);
  65.   buf := '   '+meldung;
  66.   buf[1] := chr(Hi(xpos)); buf[2] := chr(Lo(xpos));
  67.   buf[3] := chr(18);
  68.   buf [length(meldung)+5] := chr(0);
  69.   egal := DisplayAlert(RECOVERY_ALERT,buf,32);
  70. end;
  71.  
  72. { ###################################################################### }
  73. { ------------------------- Dateibehandlung ---------------------------- }
  74. { ###################################################################### }
  75.  
  76. function filetype(name: Str80): integer;
  77. { Typcodierung: }
  78. { -1: Datei existiert nicht }
  79. {  0: unbekannter Typ (vermutlich roher ASCII-Text) }
  80. {  1: programmeigener Typ 'VTPG'=$56545047 }
  81. {  2: AmigaDOS-Programmdatei $000003F3 }
  82. {  3: IFF-Datei 'FORM'=$464F524D }
  83. var head: long;
  84.     i: integer;
  85.     ch: char;
  86.     datei: text;
  87. begin
  88.   reset(datei,name);
  89.   if IOresult=0 then begin
  90.     head := 0;
  91.     for i := 1 to 4 do begin
  92.       read(datei,ch);
  93.       head := head SHL 8 + ord(ch);
  94.     end;
  95.     filetype := 0;
  96.     if head=$56545047 then filetype := 1;
  97.     if head=$000003F3 then filetype := 2;
  98.     if head=$464F524D then filetype := 3;
  99.     Close(datei);
  100.   end else
  101.     filetype := -1;
  102. end;
  103.  
  104. FUNCTION value(s: Str80): Long;
  105. { kann Hex- und Dezimalzahlen dekodieren (Hex muß mit "$" anfangen) }
  106. { Sehr primitive Version: Vorzeichen wird nicht berücksichtigt }
  107. VAR i: Integer;
  108.     x: Long;
  109. BEGIN
  110.   i := 1; x := 0;
  111.   WHILE s[i]=' ' DO Inc(i);
  112.   IF s[i]='$' THEN BEGIN
  113.     Inc(i);
  114.     WHILE s[i] IN ['0'..'9','A'..'F','a'..'f'] DO BEGIN
  115.       x := x SHL 4 + ord(s[i]);
  116.       CASE s[i] OF
  117.         '0'..'9': x := x - ord('0');
  118.         'A'..'F': x := x - ord('A') + 10;
  119.         'a'..'f': x := x - ord('a') + 10;
  120.       END;
  121.       Inc(i);
  122.     END;
  123.   END ELSE
  124.     WHILE s[i] IN ['0'..'9'] DO BEGIN
  125.       x := x*10 + ord(s[i]) - ord('0');
  126.       Inc(i);
  127.     END;
  128.   value := x;
  129. END;
  130.  
  131. FUNCTION getpages(filename: Str80): Integer;
  132. { Alle VT-Seiten aus einer VTPG-Datei einlesen und in die Seitenliste }
  133. { einreihen. Rückgabewert: Anzahl der gelesenen Seiten }
  134. VAR i, gelesen: Integer;
  135.     bytes: ^ARRAY[1..41] OF Char;
  136.     datei: Text;
  137.     zeile: Str80;
  138.     seite: p_onepage;
  139. BEGIN
  140.   gelesen := 0;
  141.   Reset(datei,filename);
  142.   IF (IOresult<>0) THEN     { Datei existiert nicht }
  143.     Exit;
  144.   WHILE NOT EoF(datei) DO BEGIN
  145.     REPEAT
  146.       ReadLn(datei,zeile);
  147.     UNTIL (zeile='VTPG') OR EoF(datei);
  148.     if zeile='VTPG' THEN BEGIN
  149.       New(seite);
  150.       FOR i := 0 to 23 DO BEGIN
  151.         bytes := Ptr(^seite^.chars[40*i]);
  152.         BlockRead(datei,bytes^,40);
  153.         ReadLn(datei);
  154.       END;
  155.       Read(datei,seite^.pg,seite^.sp); ReadLn(datei,zeile);
  156.       seite^.cbits := value(zeile);
  157.       add_to_list(seite); Inc(gelesen);
  158.     END;
  159.   END;
  160.   Close(datei);
  161.   getpages := gelesen;
  162. END;
  163.  
  164. { ###################################################################### }
  165. { ------------------------ Bildschirmausgabe --------------------------- }
  166. { ###################################################################### }
  167.  
  168. PROCEDURE stretch_line(zeile, sp0, sp1: Integer);
  169. { Streckt eine Textzeile am Bildschirm von sp0 bis einschließlich sp1 auf }
  170. { doppelte Höhe. }
  171. { Zeilen und Spalten werden, wie bei GotoXY üblich, ab 1 gezählt! }
  172. VAR charx,chary,i,y0,x0,breite: Integer;
  173. BEGIN
  174.   charx := MyWindow^.RPort^.TxWidth;
  175.   chary := MyWindow^.RPort^.TxHeight;
  176.   y0 := (zeile-1)*chary;
  177.   x0 := (sp0-1)*charx; breite := (sp1-sp0+1)*charx;
  178.   FOR i := chary-1 DOWNTO 0 DO BEGIN
  179.     ClipBlit(MyWindow^.RPort,x0,y0+i,MyWindow^.RPort,x0,y0+2*i,breite,1,$C0);
  180.     ClipBlit(MyWindow^.RPort,x0,y0+i,MyWindow^.RPort,x0,y0+2*i+1,breite,1,$C0);
  181.   END;
  182. END;
  183.  
  184. PROCEDURE writepage(seite: p_onepage, verdeckt: Boolean);
  185. { Seite am Bildschirm ausgeben }
  186. var zeile,i,j,j0: Integer;
  187.     out: bigstring;
  188.     s: str80;
  189.     dblheight,special: Boolean;
  190. begin
  191.   cursoron;
  192.   dblheight := False;
  193.   seite^.chars[0] := 2;  { Seitennummer zunächst grün }
  194.   for i := 0 to 24 do begin
  195.     zeile := i MOD 24;
  196.     IF i=24 THEN BEGIN
  197.       seite^.chars[0] := 7;  { Seitennummer weiß -> Seite komplett }
  198.       dblheight := False;
  199.     END;
  200.     IF dblheight THEN
  201.       dblheight := False
  202.     ELSE BEGIN
  203.       IF seite<>Nil THEN
  204.         decode_line(seite, zeile, verdeckt, out, dblheight)
  205.       ELSE
  206.         out := blank40;
  207.       GotoXY(1,zeile+2); Write(out,#155'0;37;40m');
  208.       IF dblheight THEN BEGIN   { Handhabung doppelthoher Zeilen }
  209.         special := False;
  210.         FOR j := 1 TO Length(out) DO BEGIN   { alles außer den ANSI-Codes }
  211.           { entfernen -> erzeugt Kopie der Hintergrundfarben der Zeile }
  212.           IF out[j] = #155 THEN special := True;
  213.           IF NOT special THEN out[j] := ' ';
  214.           IF out[j] = 'm' THEN special := False;
  215.         END;
  216.         GotoXY(1,zeile+3); write(out,#155'0;37;40m');
  217.         special := False;
  218.         FOR j := 0 TO 39 DO   { doppelthohe Abschnitte suchen }
  219.           CASE seite^.chars[40*zeile+j] OF
  220.             13: BEGIN j0 := j; special := True; END;
  221.             12: IF special THEN BEGIN
  222.                 stretch_line(zeile+2,1+j0,1+j); special := False;
  223.               END;
  224.             OTHERWISE;
  225.           END;
  226.         IF special THEN
  227.           stretch_line(zeile+2,1+j0,40);
  228.       END;
  229.     END;
  230.     lastkey := readkey; { Taste: Abbruch und Rückmeldung ans HP }
  231.     IF (lastkey<>chr(0)) OR stop THEN BEGIN
  232.       cursoroff;
  233.       exit;
  234.     END;
  235.   END;
  236.   cursoroff;
  237. END;
  238.  
  239. { ###################################################################### }
  240. { -------------------------- Initialisierungen ------------------------- }
  241. { ###################################################################### }
  242.  
  243. PROCEDURE get_args;
  244. { Wertet CLI- oder WorkBench-Argumente aus: Die spezifizierten Dateien }
  245. { werden mit getpages() eingelesen. }
  246. { ToolTypes:                  CLI-Parameter:  }
  247. { MODE=MAN|AUTO|CYCLE         -a -c }
  248. { FLAGS=REVEAL|CONCEAL        -r }
  249. { TIMING=<secs>               -t<secs> }
  250. VAR c: char;
  251.     s: bigstring;
  252.     len,i,j,ok: integer;
  253.     hail: p_WBStartup;
  254.     arg: p_WBArg;
  255.     olddir: BPTR;
  256.     icon: p_DiskObject;
  257.     entry: Str;
  258.     name: Str80;
  259. FUNCTION is_space(ch: Char): Boolean;
  260. BEGIN  is_space := (ch=' ') OR (ch=#9) OR (ch=#10) OR (ch=#13);  END;
  261. BEGIN
  262.   conceal := True;
  263.   auto := False;
  264.   cycle := False;
  265.   timing := 2;
  266.   anzseiten := 0;
  267.   IF fromWB then begin
  268.     OpenLib(IconBase,'icon.library',0);
  269.     hail := StartupMessage;
  270.     arg := hail^.sm_ArgList;
  271.     for i := 1 to hail^.sm_NumArgs do begin
  272.       olddir := CurrentDir(arg^.wa_Lock);
  273.       name := arg^.wa_Name;
  274.       if filetype(name)=1 THEN    { nur VTPG-Dateien lesen }
  275.         anzseiten := anzseiten + getpages(name);
  276.       icon := GetDiskObject(arg^.wa_Name);
  277.       if icon<>Nil then begin
  278.         entry := FindToolType(icon^.do_ToolTypes, 'MODE');
  279.         IF ptr(entry)<>Nil THEN BEGIN
  280.           IF MatchToolValue(entry,'MAN') THEN auto := False;
  281.           IF MatchToolValue(entry,'AUTO') THEN BEGIN
  282.             auto := True; cycle := False; END;
  283.           IF MatchToolValue(entry,'CYCLE') THEN BEGIN
  284.             auto := True; cycle := True; END;
  285.         END;
  286.         entry := FindToolType(icon^.do_ToolTypes, 'FLAGS');
  287.         IF ptr(entry)<>Nil THEN BEGIN
  288.           IF MatchToolValue(entry,'REVEAL') THEN conceal := False;
  289.           IF MatchToolValue(entry,'CONCEAL') THEN conceal := True;
  290.         END;
  291.         entry := FindToolType(icon^.do_ToolTypes, 'TIMING');
  292.         if ptr(entry)<>Nil then
  293.           Val(entry,timing,ok);
  294.         FreeDiskObject(icon);
  295.       end;
  296.       olddir := CurrentDir(olddir);
  297.       { auf nächsten WBArg-Zeiger zugreifen: }
  298.       arg := ptr(long(arg)+SizeOf(WBArg));
  299.     end;
  300.     CloseLib(IconBase);
  301.   end else if ParameterLen>0 then begin
  302.     s := copy(ParameterStr,1,ParameterLen);
  303.     len := length(s);
  304.     { Parameterzeile in Worte zerlegen, wie der argv[] in C es schon ist :-( }
  305.     i := 1; while i<=len do begin
  306.       while is_space(s[i]) do Inc(i);
  307.       j := i + 1;
  308.       if s[i]='"' then begin
  309.         Inc(i); while (s[j]<>'"') AND (j<=len) do Inc(j);
  310.       end else begin
  311.         while NOT is_space(s[j]) AND (j<=len) do Inc(j);
  312.       end;
  313.       { Zeiger i: 1. Zeichen des Wortes, j: 1. Trennzeichen dahinter }
  314.       if s[i]='-' then begin
  315.         i := i+2;
  316.         case s[i-1] of
  317.           't': Val(copy(s,i,j-i),timing,ok);
  318.           'r': conceal := False;
  319.           'a': auto := True;
  320.           'c': BEGIN auto := True; cycle := True; END;
  321.           otherwise begin
  322.             writeln('usage:');
  323.             writeln('VTview <file> <file> ... -r[eveal] -a[uto] -c[ycle] -t<secs> ');
  324.             writeln('with <file> containing raw VideoText pages ("VTPG" format)');
  325.           end;
  326.         end;
  327.       END ELSE
  328.         IF filetype(copy(s,i,j-i))=1 THEN
  329.           anzseiten := anzseiten + getpages(copy(s,i,j-i))
  330.         ELSE
  331.           Writeln('Keine VTPG-Datei: ',copy(s,i,j-i));
  332.       i := j + 1;
  333.     end;
  334.   end;
  335. END;
  336.  
  337. PROCEDURE sysinit;
  338. CONST breite=320;
  339.       hoehe=256;
  340. var i: integer;
  341.     egal: long;
  342. begin
  343.   { Zuerst Zeiger für den zugehörigen ExitServer initialisieren: }
  344.   IntuitionBase := Nil; GfxBase := Nil; DiskFontBase := Nil;
  345.   MyScreen := Nil; MyWindow := Nil; MyFont := Nil;
  346.   { Libraries etc. öffnen: }
  347.   IntuitionBase := OpenLibrary('intuition.library',0);
  348.   GfxBase := OpenLibrary('graphics.library',0);
  349.   DiskFontBase := OpenLibrary('diskfont.library',0);
  350.   if IntuitionBase=Nil then Error('Can''t open intuition.library!');
  351.   if GfxBase=Nil then Error('Can''t open graphics.library!');
  352.   if DiskfontBase=Nil then desaster('Can''t open diskfont.library !!!');
  353.   topazAttr := TextAttr('topaz.font',8,FS_NORMAL,FPF_ROMFONT);
  354.   titel := copy(version,7,length(version)-6)
  355.            +' ('+IntStr(anzseiten)+' pages) ESC to quit';
  356.   NeuerScreen := NewScreen(0,0,breite,hoehe,3,6,4,GENLOCK_VIDEO,
  357.     CUSTOMSCREEN,^topazAttr,titel,Nil,Nil);
  358.   MyScreen := OpenScreen(^NeuerScreen);
  359.   for i := 0 to 7 do
  360.     SetRGB4(^MyScreen^.ViewPort, i, 15*( i        and 1),
  361.                                     15*((i div 2) and 1),
  362.                                     15*((i div 4) and 1));
  363.   NeuesWindow := NewWindow(0,11,breite,hoehe-11,2,1, 0,
  364.            ACTIVATE or BORDERLESS or BACKDROP,
  365.            Nil,Nil,Nil,MyScreen,Nil,170,100,breite,hoehe,CUSTOMSCREEN);
  366.   MyWindow := OpenWindow(^NeuesWindow);
  367.   teleAttr := TextAttr('videotext.font',9,FS_NORMAL,FPF_DISKFONT);
  368.   if DiskFontBase<>Nil then
  369.     MyFont := OpenDiskFont(^teleAttr);
  370.   if MyFont<>Nil then
  371.     egal := SetFont(MyWindow^.RPort,MyFont)
  372.   else
  373.     desaster('Can''t open videotext.font !!!');
  374.   Con := OpenConsole(MyWindow);
  375.   SetStdIO(Con);
  376. end;
  377.  
  378. procedure sysclean;
  379. begin
  380.   if MyWindow<>Nil then  CloseWindow(MyWindow);
  381.   if MyScreen<>Nil then if CloseScreen(MyScreen) then;
  382.   if MyFont<>Nil then CloseFont(MyFont);
  383.   if IntuitionBase<>Nil then CloseLibrary(IntuitionBase);
  384.   if GfxBase<>Nil then CloseLibrary(GfxBase);
  385.   if DiskFontBase<>Nil then CloseLibrary(DiskFontBase);
  386.   { festhalten, daß alles geschlossen ist: }
  387.   MyWindow := Nil;
  388.   MyScreen := Nil;
  389.   MyFont := Nil;
  390.   IntuitionBase := Nil;
  391.   GfxBase := Nil;
  392.   DiskFontBase := Nil;
  393. end;
  394.  
  395. { ###################################################################### }
  396. { ------------------ Hauptprogramm/Ereignisverwaltung ------------------ }
  397. { ###################################################################### }
  398.  
  399. procedure handle_key(key: char);
  400. { der Übersichtlichkeit halber aus dem Hauptprogramm herausgezogen }
  401. var j,ok,ft: integer;
  402.     s: String[20];
  403. begin
  404.   case key of
  405.     #27: stop := true;
  406.     #127: if thispage<>Nil then begin  { Del: eine Seite löschen }
  407.           del_from_list(thispage);
  408.           writepage(Nil,true);
  409.         end;
  410.     ' ': writepage(thispage,true);
  411.     '?': writepage(thispage,false);
  412.     otherwise;
  413.   end;
  414. end;
  415.  
  416. PROCEDURE handle_escseq(chars: str80);
  417. { wie handle_key, aber für die ESC-Sequenzen der Sondertasten }
  418. VAR i,page,page2: Integer;
  419. BEGIN
  420.   { Cursor: Seitenliste durchblättern }
  421.   IF Pos(chars,'ABCDST')>0 THEN BEGIN
  422.     IF thispage<>Nil THEN BEGIN
  423.       if (chars='A') then
  424.         if (thispage^.prev<>Nil) then
  425.           thispage := thispage^.prev;
  426.       if (chars='B') then
  427.         if (thispage^.next<>Nil) then
  428.           thispage := thispage^.next;
  429.       if chars='S' then
  430.         thispage := next_magazine(thispage);
  431.       if chars='T' then
  432.         thispage := prev_magazine(thispage);
  433.       IF (chars='C') THEN
  434.         WHILE (thispage^.next<>Nil) DO
  435.           thispage := thispage^.next;
  436.       IF (chars='D') THEN
  437.         thispage := root;
  438.     END;
  439.     writepage(thispage,conceal);
  440.   END;
  441. END;
  442.  
  443. begin   { Hauptprogramm }
  444.   root := Nil;   { Seitenliste }
  445.   thispage := Nil;
  446.   get_args;   { u. a. Namen für Ausgabedatei holen }
  447.   AddExitServer(sysclean); sysinit;
  448.   cursoroff;
  449.   stop := False;  countdown := timing;
  450.   lastkey := #0;
  451.   REPEAT
  452.     if (thispage=Nil) AND (root<>Nil) then begin
  453.       thispage := root;
  454.       writepage(thispage,conceal);
  455.     end;
  456.     if lastkey=#0 then
  457.       taste := ReadCon(Con)
  458.     else begin
  459.       taste := lastkey; lastkey := #0;
  460.     end;
  461.     if taste<>#0 then auto := False;
  462.     if taste=#155 then begin { Sondertasten auswerten }
  463.       s := '';
  464.       repeat
  465.         ch := readkey; if ch<>#0 then s := s + ch;
  466.       until ch = #0;
  467.       handle_escseq(s);
  468.     end else if taste<>#0 then
  469.       handle_key(taste)
  470.     ELSE IF auto THEN BEGIN
  471.       Delay(50); Dec(countdown);
  472.       IF countdown<=0 THEN
  473.         IF thispage<>Nil THEN BEGIN
  474.           IF thispage^.next=Nil THEN
  475.             IF cycle THEN thispage := root ELSE stop := True
  476.           ELSE
  477.             thispage := thispage^.next;
  478.           IF NOT stop THEN BEGIN
  479.             writepage(thispage,conceal);
  480.             countdown := timing;
  481.           END;
  482.         END ELSE
  483.           stop := True;
  484.     END else
  485.       sig := Wait(-1);
  486.   until stop;
  487.   SetStdIO(Nil); CloseConsole(Con);
  488.   kill_list; sysclean;
  489. end.
  490.  
  491.